home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / DB_CLIPP / 2614.ZIP / TBROWS.ZIP / TTBR5.PRG < prev    next >
Text File  |  1990-10-26  |  3KB  |  155 lines
  1. /*****
  2.  *
  3.  * TTBR5.PRG
  4.  * Fifth example for TBROWSE class using a database file
  5.  *
  6.  * 20 October 90
  7.  * Luiz Quintela - Nantucket Corp
  8.  *
  9.  * Clipper ttbr5 /N/W/A/B
  10.  * RTLINK FILE ttbr5 PLL base50
  11.  *
  12.  */
  13.  
  14. // Include Header Files
  15. #include "inkey.ch"
  16. #include "setcurs.ch"
  17.  
  18. FUNCTION Main()
  19. LOCAL b, column, nKey, aColors
  20. SET SCOREBOARD OFF
  21. SET DATE       BRITISH
  22. SET CONFIRM    ON
  23.  
  24. USE test INDEX test NEW
  25. // Turn cursor off
  26. SETCURSOR(SC_NONE)
  27. SETCOLOR( "BG/B" ); CLS
  28.  
  29. b := TBrowseDB( 2, 2, 20, 48)
  30.  
  31. // Now, we will use some colors for this column
  32. // You will use the instance variable colorSpec, which contains a
  33. // character string defining a color table to the browse display.
  34. // As a default, the current SETCOLOR is copied into this 
  35. // variable
  36. b:colorSpec := "BG/B,GR+/R,W/N,N,GR+/W,G/B,R+/B,GR+/B"
  37.  
  38. b:colSep := " │ "
  39. b:headSep := "═╤═"
  40. b:footSep := "═══"
  41.  
  42. // TBColumn objects
  43. column := TBColumnNew( "Field 1", {|| test->fld1} )
  44. column:footing := "First"
  45. b:addColumn( column )
  46. column := TBColumnNew( "Field 2", {|| test->fld2} )
  47. b:addColumn( column )
  48. column := TBColumnNew( "Field 3", {|| test->fld3} )
  49. b:addColumn( column )
  50. column := TBColumnNew( "Field 4", {|| test->fld4} )
  51. b:addColumn( column )
  52.  
  53. // defColor contains an array of numeric indexes into the color
  54. // table. The first determines the unselected color which
  55. // determines the color used to headings, footings, etc.
  56. // It is also used to display values when the cursor is not
  57. // on the data value being displayed.
  58. // The second value determines the selected color which is used
  59. // to display the current browse cell
  60. // Note that colors set using tBColumn:colorBlock overrides those
  61. // set by TBColumn:defColor
  62. column := TBColumnNew( "Field 5", {|| test->fld5} )
  63. column:colorBlock := { |y| IF(y < 4, { 6, 2 },;
  64.                            IF(y > 5, { 7, 2 }, { 8, 2 } )) }
  65. column:footing := "Last"
  66. b:addColumn( column )
  67.  
  68. // Freeze one column 
  69. b:freeze := 1
  70.  
  71. WHILE .T.
  72.    // Do not allow cursor to move into frozen columns
  73.    IF  ( b:colPos <= 1 )
  74.        // As you can see b:colPos is assignable
  75.        b:colPos := b:freeze + 1
  76.  
  77.    ENDIF
  78.  
  79.    // Stabilization
  80.    WHILE ( !b:stabilize() )
  81.       nKey := InKey()
  82.       IF ( nKey != 0 )
  83.          EXIT // abort if a key is waiting
  84.  
  85.       ENDIF
  86.  
  87.    END
  88.  
  89.    IF ( b:stable )
  90.       // Is always a good idea tell the user about end or 
  91.       // beginning of file
  92.  
  93.       IF ( b:hitTop .OR. b:hitBottom )
  94.           TONE(87.3,1)
  95.          TONE(40,3.5)
  96.  
  97.       ENDIF
  98.  
  99.       // everything's done; just wait for a key
  100.       nKey := INKEY(0)         
  101.  
  102.    ENDIF
  103.  
  104.    // Process key
  105.     IF ( nKey == K_DOWN )
  106.       b:down()
  107.  
  108.    ELSEIF ( nKey == K_UP )
  109.       b:up()
  110.  
  111.    ELSEIF ( nKey == K_PGDN )
  112.       b:pageDown()
  113.  
  114.    ELSEIF ( nKey == K_PGUP )
  115.       b:pageUp()
  116.  
  117.    ELSEIF ( nKey == K_CTRL_PGUP )
  118.       b:goTop()
  119.  
  120.    ELSEIF ( nKey == K_CTRL_PGDN )
  121.       b:goBottom()
  122.  
  123.    ELSEIF ( nKey == K_RIGHT )
  124.       b:right()
  125.  
  126.    ELSEIF ( nKey == K_LEFT )
  127.       b:left()
  128.  
  129.    ELSEIF ( nKey == K_HOME )
  130.       b:home()
  131.  
  132.    ELSEIF ( nKey == K_END )
  133.       b:end()
  134.  
  135.    ELSEIF ( nKey == K_CTRL_LEFT )
  136.       b:panLeft()
  137.  
  138.    ELSEIF ( nKey == K_CTRL_RIGHT )
  139.       b:panRight()
  140.  
  141.    ELSEIF ( nKey == K_CTRL_HOME )
  142.       b:panHome()
  143.  
  144.    ELSEIF ( nKey == K_CTRL_END )
  145.       b:panEnd()
  146.  
  147.    ELSEIF ( nKey == K_ESC )
  148.         CLS; SETCURSOR(SC_NORMAL); QUIT
  149.  
  150.     ENDIF
  151.  
  152. END
  153.  
  154. /* EOF - TTBR5.PRG */
  155.